;;functions to check for string similarity
;;we will use this to group words from wordinventory, so that similar words
;;will have a pooled frequency count
;;algorithm idea inspired from http://www.catalysoft.com/articles/StrikeAMatch.html

(defun substring-list (string int) "takes a string and creates a list of consecutive letters, for example (x-letters hello 3) yields (hel ell llo) and (x-letters hello 2) yields (he el ll lo)"
  
  ;;if letterlist is not defined

  (if (not (boundp 'letterlist))
      (setq letterlist '())
  )

  (if (<= int (length string))
  ;;if there there are enough index positions
  (setq letterlist (flatten (list letterlist (read-from-string (subseq string 0 int)))))
  ;;if not, just return the whole word
  (setq letterlist (list (read-from-string string)))
  )
 
  (if (> (length string) int) ;;if were not at the end yet,

      ;;then keep going
      (substring-list (subseq string 1) int)
     
      ;;else stop
      (progn
      (setq output letterlist)
      (setq letterlist '())
      output
      )
  )
)

(defun compare-strings (str1 str2) "takes two strings and sees commonalities in the pairs of letters, and divides 2x the number of common pairs to the total number of pairs, this returns a value between 0 and 1, where 0 is not similar at all and 1 is exactly the same,"

;;ls x means the list where the word is broken up so that each item in the list has x consecutive letters
(let (
      (ls1 (substring-list str1 3))
      (ls2 (substring-list str2 3))
      (bonus 0)
     )

;;if they have the same first "x" letters, give a bonus, most prefixes are only 2 letters long, so we don't really have to worry about something like decode and design getting too good a score

(if (and (>= (length str1) 3) (>= (length str2) 3))
    (if (equal (subseq str1 0 3) (subseq str2 0 3))
	(setq bonus 2)
    )
)

(if (and (>= (length str1) 4) (>= (length str2) 4))
    (if (equal (subseq str1 0 4) (subseq str2 0 4))
	(setq bonus 3)
      )
)

(if (and (>= (length str1) 5) (>= (length str2) 5))
    (if (equal (subseq str1 0 5) (subseq str2 0 5))
	(setq bonus 4)
      )
)

(+ (length (intersection ls1 ls2)) bonus)

)

)





(defun link-words (wordinventory) "takes finds relations in between words and combines their frequencies, example output: (link-words '((happy happily great)(1 2 3)) --> '(((happy happily) (great))(3 3))"

(let (
     (newwordlist '())
     (newfrequencylist '())
     (templist (car wordinventory))
     (oldwordlist (car wordinventory))
     (oldfrequencylist (nth 1 wordinventory))
     )
     
     (while templist do

	;;the scores of the words compared to (car templist)
	(setq scores (mapcar #'(lambda (str) (compare-strings (symbol-name (car templist)) str)) (mapcar #'symbol-name (flatten newwordlist))))
	(if scores
	(setq highestscore (apply #'max scores))
	(setq highestscore 0)
	)
	;;if its similar to a word already in the list, gets a score of 5 or more
        (if (>= highestscore 5)
	    
	    ;;then
	    (progn
	       (setq similarword (nth (position highestscore scores) (flatten newwordlist)))
	       (setq index (position (find similarword (symbols-to-list newwordlist) :key #'(lambda (arg) (find similarword arg))) (symbols-to-list newwordlist)))
	       (setf (nth index newwordlist) (flatten (list (nth index newwordlist) (car templist))))
	       (setf (nth index newfrequencylist) (+ (nth index newfrequencylist) (nth (position (car templist) oldwordlist) oldfrequencylist)))
	    )
	    
	    ;;else if its not similar
	    (progn
	       (setq newwordlist (left-rotate (cons (car templist) newwordlist)))
	       (setq newfrequencylist (left-rotate (cons (nth (position (car templist) oldwordlist) oldfrequencylist) newfrequencylist)))
	    )
        )


	(setq templist (cdr templist))
     )
     (list (symbols-to-list newwordlist) newfrequencylist)
)


)